home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
lisp
/
kcl
/
akcl
/
akcl1615.lha
/
V
/
lsp
/
numlib.lsp
< prev
next >
Wrap
Lisp/Scheme
|
1992-04-11
|
4KB
|
143 lines
Changes file for /usr/local/src/kcl/lsp/numlib.lsp
Created on Sat Apr 11 09:20:43 1992
Usage \n@s[Original text\n@s|Replacement Text\n@s]
See the file rascal.ics.utexas.edu:/usr2/ftp/merge.c
for a program to merge change files. Anything not between
"\n@s[" and "\n@s]" is a simply a comment.
This file was constructed using emacs and merge.el
Enhancements Copyright (c) W. Schelter All rights reserved.
by (Bill Schelter) wfs@carl.ma.utexas.edu
****Change:(orig (29 29 c))
@s[(defconstant imag-one #C(0.0s0 1.0s0))
@s|(defconstant imag-one #C(0.0d0 1.0d0))
@s]
****Change:(orig (64 65 c))
@s[ (sqrt (- 1.0s0 (* x x)))))))))
(if (and (not (complexp x)) (zerop (imagpart c)))
@s| (sqrt (- 1.0d0 (* x x)))))))))
(if (or (not (complexp x)) (zerop (imagpart c)))
@s]
****Change:(orig (72 73 c))
@s[ (sqrt (- 1.0s0 (* x x))))))))))
(if (and (not (complexp x)) (zerop (imagpart c)))
@s| (sqrt (- 1.0d0 (* x x))))))))))
(if (or (not (complexp x)) (zerop (imagpart c)))
@s]
****Change:(orig (77 78 c))
@s[(defun sinh (x) (/ (- (exp x) (exp (- x))) 2.0s0))
(defun cosh (x) (/ (+ (exp x) (exp (- x))) 2.0s0))
@s|(defun sinh (x) (/ (- (exp x) (exp (- x))) 2.0d0))
(defun cosh (x) (/ (+ (exp x) (exp (- x))) 2.0d0))
@s]
****Change:(orig (81 81 c))
@s[(defun asinh (x) (log (+ x (sqrt (+ 1.0s0 (* x x))))))
@s|(defun asinh (x) (log (+ x (sqrt (+ 1.0d0 (* x x))))))
@s]
****Change:(orig (87 87 c))
@s[ (when (or (= x 1.0s0) (= x -1.0s0))
@s| (when (or (= x 1.0d0) (= x -1.0d0))
@s]
****Change:(orig (91 91 c))
@s[ (log (/ (1+ x) (sqrt (- 1.0s0 (* x x))))))
@s| (log (/ (1+ x) (sqrt (- 1.0d0 (* x x))))))
@s]
****Change:(orig (95 98 c))
@s[ (multiple-value-bind (i e s) (integer-decode-float x)
(if (>= s 0)
(* i (expt (float-radix x) e))
(- (* i (expt (float-radix x) e))))))
@s| (etypecase x
(float
(multiple-value-bind (i e s) (integer-decode-float x)
(if (>= s 0)
(* i (expt (float-radix x) e))
(- (* i (expt (float-radix x) e))))))
(rational x)))
@s]
****Change:(orig (100 100 a))
@s[
@s|
(setf (symbol-function 'rationalize) (symbol-function 'rational))
;; although the following is correct code in that it approximates the
;; x to within eps, it does not preserve (eql (float (rationalize x) x) x)
;; since the test for eql is more strict than the float-epsilon
@s]
****Change:(orig (103 127 c))
@s[(defun rationalize (x)
(typecase x
(rational x)
(short-float (rationalize-float x short-float-epsilon))
@s, (/ num den)))))))
@s|;(defun rationalize (x)
; (typecase x
; (rational x)
; (short-float (rationalize-float x short-float-epsilon 1.0s0))
; (long-float (rationalize-float x long-float-epsilon 1.0d0))
; (otherwise (error "~S is neither rational nor float." x))))
;
;(defun rationalize-float (x eps one)
; (cond ((minusp x) (- (rationalize (- x))))
; ((zerop x) 0)
; (t (let ((y ())
; (a ()))
; (do ((xx x (setq y (/ one
; (- xx (float a x)))))
; (num (setq a (truncate x))
; (+ (* (setq a (truncate y)) num) onum))
; (den 1 (+ (* a den) oden))
; (onum 1 num)
; (oden 0 den))
; ((and (not (zerop den))
; (not (> (abs (/ (- x (/ (float num x)
; (float den x)))
; x))
; eps)))
; (/ num den)))))))
@s]